{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Languages;

interface

uses Classes, NameValues, UIObjects, XMLHelper;

{$IFDEF DESIGNER}
const
  MODIFY_CAPTION = 'Edit Text';

  // Property categories and hints for designer
  CAT_LANGUAGE = 'Language';
  HINT_TEXT = 'defines text translations for this language';
{$ENDIF}

type
  TAHMLanguage = class(TAHMUIObject)
  private
    FValues: TAHMNameValueList;
  protected
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    property Translations: TAHMNameValueList read FValues;
    function Translate(TextCode: String): String;
    procedure AddTranslation(TextCode, Translation: String);
    procedure UpdateTranslation(TextCode, Translation: String);
    function DeleteTranslation(TextCode: String): Boolean;
    function RenderPreview: Boolean; override;
    function ModifyActions: Integer; override;
    function Modify(Action: Integer): Boolean; override;
    function ModifyValue(var Value: String; const Parameter: String): Boolean; override;
    function ModifyCaption(Action: Integer): String; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
  end;

  TAHMLanguageList = class(TAHMUIObjectList)
  private
  protected
    function GetLanguage(const Name: String): TAHMLanguage;
  public
    constructor Create; override;
    property Languages[const Name: String]: TAHMLanguage read GetLanguage; default;
    function AddLanguage(const InheritFrom, NewName: String): TAHMLanguage;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
  end;

  TAHMLanguageManager = class
  private
    FCurrentLanguage: TAHMLanguage;
    FNativeLanguage: TAHMLanguage;
    FLanguages: TAHMLanguageList;
    FTranslationErrors: TStringList;
    FPrefLangName: String;
    FNativeLangName: String;
    FBaseMgr: TAHMLanguageManager;
  protected
    property CurrentLanguage: TAHMLanguage read FCurrentLanguage write FCurrentLanguage;
    property NativeLanguage: TAHMLanguage read FNativeLanguage write FNativeLanguage;
    procedure SetBaseManager(BaseManager: TAHMLanguageManager);
    procedure SetCurrentLanguageName(Name: String);
    function GetCurrentLanguageName: String;
  public
    constructor Create;
    destructor Destroy; override;
    property BaseManager: TAHMLanguageManager read FBaseMgr write SetBaseManager;
    property PreferredLanguageName: String read FPrefLangName write FPrefLangName;
    property Languages: TAHMLanguageList read FLanguages;
    property CurrentLanguageName: String read GetCurrentLanguageName write SetCurrentLanguageName;
    property NativeLanguageName: String read FNativeLangName write FNativeLangName;
    function Translate(TextCode: String): String;
    procedure Initialise;
    procedure SaveAsXML(Lines: TStrings);
    procedure Assign(Source: TAHMLanguageManager);
  end;

var
  LanguageManagerInstance: TAHMLanguageManager;

implementation

uses SysUtils, MetaConsts, ApplicationManager, Screen, TagNames, XMLTags,
     {$IFDEF DESIGNER}DesignerLanguage, DesignerTextEdit,{$ENDIF} AHMTypes,
     Logging;

constructor TAHMLanguageList.Create;
begin
  inherited Create;

  XMLTagName := TAG_LANGUAGES;
  ChildClass := TAHMLanguage;
end;

function TAHMLanguageList.AddLanguage(const InheritFrom, NewName: String): TAHMLanguage;
begin
    Result := TAHMLanguage(Inherit(InheritFrom, NewName));
end;

function TAHMLanguageList.GetLanguage(const Name: String): TAHMLanguage;
begin
  Result := TAHMLanguage(GetObject(Name));
end;

procedure TAHMLanguageList.ParseFromXML(XML: TAHMXMLHelper);
var
  sName, sInherit, sDesc, sComment: String;
  RootNode, ItemNode: TAHMXMLNode;
begin
  // Store description, comments & prepare for parsing
  Description := XML.GetAttribute(ATTR_DESC);
  Comment := XML.CurrentComment;
  RootNode := XML.CurrentNode;
  ItemNode := nil;

  // Keep going as long as we find child tags to process
  while XML.NextElement(RootNode, ItemNode) do
  begin
    // Get standard object attributes
    sName    := XML.GetAttribute(ATTR_NAME);
    sInherit := XML.GetAttribute(ATTR_INHERIT);
    sDesc    := XML.GetAttribute(ATTR_DESC);
    sComment := XML.CurrentComment;

    // Construct a new language instance with relevant details
    with AddLanguage(sInherit, sName) do
    begin
      if sDesc <> '' then Description := sDesc;
      if sComment <> '' then Comment := sComment;

      // Allow language to parse its own custom properties
      ParseFromXML(XML);
    end;
  end;
end;

//----------------------------------------------------------------------------//

constructor TAHMLanguage.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_LANGUAGE;
  ObjectType := otLanguages;
  ImageIndex := Ord(otLanguages);

  FValues := TAHMNameValueList.Create;
end;

destructor TAHMLanguage.Destroy;
begin
  FValues.Free;

  inherited Destroy;
end;

procedure TAHMLanguage.ClearProperties;
begin
  inherited;

  // Clear custom language properties
  FValues.Clear;
end;

function TAHMLanguage.Translate(TextCode: String): String;
begin
  Result := FValues.GetValue(TextCode);

  // If not found then check in base values
  if (Result = '') and Assigned(FValues.Parent) then
    Result := FValues.Parent.GetValue(TextCode);
end;

procedure TAHMLanguage.AddTranslation(TextCode, Translation: String);
begin
  FValues.AddValue(TextCode, Translation);
end;

procedure TAHMLanguage.UpdateTranslation(TextCode, Translation: String);
begin
  // Update translation in base values if not defined in custom values.
  // Otherwise either update or add new value to our custom values
  if Assigned(FValues.Parent) and (FValues.IndexOf(TextCode) < 0) and
     (FValues.Parent.IndexOf(TextCode) > -1) then
    FValues.Parent.AddValue(TextCode, Translation)
  else
    FValues.AddValue(TextCode, Translation);
end;

function TAHMLanguage.DeleteTranslation(TextCode: String): Boolean;
var
  Index: Integer;
begin
  Index := FValues.IndexOf(TextCode);
  Result := not (Index < 0);
  if Result then FValues.Delete(Index);
end;

function TAHMLanguage.RenderPreview: Boolean;
begin
{$IFDEF DESIGNER}
  with ScreenInstance.Viewport do
  begin
    Canvas.DesignerBackground(ViewportRect);
    Canvas.TextRect(ViewportRect, nil, 'Language Strings:' + sLineBreak + FValues.Text);
  end;
{$ENDIF}
  Result := True;
end;

function TAHMLanguage.ModifyActions: Integer;
begin
  // Language supports single action to edit translations
  Result := 1;
end;

function TAHMLanguage.Modify(Action: Integer): Boolean;
begin
{$IFDEF DESIGNER}
  // Edit translations with language dialog
  with LanguageManagerInstance do
    Result := TfrmLanguage.ShowLanguage(Self, NativeLanguage);

  if Result then DoModified;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TAHMLanguage.ModifyValue(var Value: String; const Parameter: String): Boolean;
begin
{$IFDEF DESIGNER}
  // Edit value with text dialog
  Result := TfrmTextProperties.EditText(Value, Parameter, Self);

  if Result then DoModified;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TAHMLanguage.ModifyCaption(Action: Integer): String;
begin
{$IFDEF DESIGNER}
  Result := MODIFY_CAPTION;
{$ELSE}
  Result := '';
{$ENDIF}
end;

procedure TAHMLanguage.Assign(Source: TPersistent);
begin
  inherited;

  with Source as TAHMLanguage do
    Self.Translations.Assign(Translations);
end;

procedure TAHMLanguage.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMLanguage;
  sWork: String;
  i: Integer;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMLanguage(ObjectToCompare);

  // Store unique and overridden text translations
  for i := 0 to Pred(FValues.Count) do
  begin
    sWork := oAncs.Translate(FValues[i]);
    if (Length(sWork) = 0) or (sWork <> FValues.Values[i]) then
    begin
      sWork := TGB+TAG_TEXT+SPC+ATTR_NAME+ATB + EncodeXML(FValues[i]) + ATC +
               EncodeXML(FValues.Values[i]) + TGE+TAG_TEXT+TGC;
      Lines.Add(TABS[XMLIndent + 3] + sWork);
    end;
  end;
end;

procedure TAHMLanguage.ParseFromXML(XML: TAHMXMLHelper);
var
  sName, sText: String;
  LangNode, TextNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  LangNode := XML.CurrentNode;
  TextNode := nil;

  // If description not set then default to language name
  if Description = '' then Description := Name;

  FValues.BeginUpdate;
  try
    // Keep going as long as we find text entries to process
    while XML.FindElement(LangNode, TextNode, TAG_TEXT) do
    begin
      sName := XML.GetAttribute(ATTR_NAME);
      sText := XML.GetValue;

      // Add translation to relevant language object
      AddTranslation(sName, sText);
    end;
  finally
    FValues.EndUpdate;
  end;
end;

//----------------------------------------------------------------------------//

constructor TAHMLanguageManager.Create;
begin
  inherited Create;

  FLanguages := TAHMLanguageList.Create;
  FTranslationErrors := TStringList.Create;
  FTranslationErrors.CaseSensitive := False;
  FTranslationErrors.Sorted := True;
end;

destructor TAHMLanguageManager.Destroy;
begin
  FLanguages.FreeWithContents;
  FTranslationErrors.Free;

  inherited Destroy;
end;

procedure TAHMLanguageManager.SetBaseManager(BaseManager: TAHMLanguageManager);
begin
  // Copy language properties from passed base langugage manager
  FBaseMgr := BaseManager;
  FPrefLangName := BaseManager.PreferredLanguageName;
  FNativeLangName := BaseManager.NativeLanguageName;
end;

procedure TAHMLanguageManager.SetCurrentLanguageName(Name: String);
begin
  FCurrentLanguage := FLanguages.GetLanguage(Name);
  if Assigned(FBaseMgr) then FBaseMgr.SetCurrentLanguageName(Name);
end;

function TAHMLanguageManager.GetCurrentLanguageName: String;
begin
  if Assigned(FCurrentLanguage) then Result := FCurrentLanguage.Name
                                else Result := '';
end;

function TAHMLanguageManager.Translate(TextCode: String): String;
begin
  // Ask current language to translate first if we have one
  if Assigned(FCurrentLanguage) then
    Result := FCurrentLanguage.Translate(TextCode)
  else
    Result := '';

  // If no joy, we'll pass to native language if we have one
  if (Result = '') and Assigned(FNativeLanguage) and
     (FNativeLanguage <> FCurrentLanguage) then
    Result := FNativeLanguage.Translate(TextCode);

  // If still no match then flag up as missing text
  if (Result = '') and (FTranslationErrors.IndexOf(TextCode) < 0) then
  begin
    // Log unknown translations, but only once each to avoid logfile clutter
    FTranslationErrors.Add(TextCode);
    LogWarn('Unknown text code requested for translation: ' + TextCode);
  end;

  // If translated string has any meta-data placeholders then replace them
  if Pos(META_MARKER, Result) > 0 then
    Result := ApplicationManagerInstance.MetaDataManager.ProcessMarkup(Result);
end;

procedure TAHMLanguageManager.Initialise;
var
  i: Integer;
  CustLanguage, BaseLanguage: TAHMLanguage;
begin
  // Set preferred language name
  FCurrentLanguage := nil;
  if FPrefLangName <> '' then
    FCurrentLanguage := FLanguages.GetLanguage(FPrefLangName);

  // Set preferred native language name
  if FNativeLangName <> '' then
    FNativeLanguage := FLanguages.GetLanguage(FNativeLangName);

  // If no native language, use first language defined
  if (FNativeLanguage = nil) and (FLanguages.Count > 0) then
  begin
    FNativeLanguage := TAHMLanguage(FLanguages.Objects[0]);
    FNativeLangName := FNativeLanguage.Name;
  end;

  // Try native language if preferred language not found
  if FCurrentLanguage = nil then
    FCurrentLanguage := FNativeLanguage;

  // Apply parent language property to each matching language
  if Assigned(FBaseMgr) then
    for i := 0 to Pred(FLanguages.Count) do
    begin
      CustLanguage := TAHMLanguage(FLanguages.Objects[i]);
      BaseLanguage := FBaseMgr.Languages[CustLanguage.Name];
      if Assigned(BaseLanguage) then
        CustLanguage.Translations.Parent := BaseLanguage.Translations
      else
        CustLanguage.Translations.Parent := nil;
    end;
end;

procedure TAHMLanguageManager.SaveAsXML(Lines: TStrings);
begin
  // Save supported languages
  Lines.Add('');
  Lines.Add(TABS[1] + BeginTag(TAG_NATIVE_LANGUAGE));
  Lines.Add(TABS[2]+TGB+TAG_LANGUAGE+SPC+ATTR_NAME+ATB + EncodeXML(FNativeLangName) + ATE);
  Lines.Add(TABS[1] + EndTag(TAG_NATIVE_LANGUAGE));
  Lines.Add('');

  // Save language list
  FLanguages.SaveAsXML(Lines);
end;

procedure TAHMLanguageManager.Assign(Source: TAHMLanguageManager);
begin
  // Copy properties from language manager
  FLanguages.AssignContents(Source.Languages);
  FPrefLangName := Source.PreferredLanguageName;
  FNativeLangName := Source.NativeLanguageName;
  SetCurrentLanguageName(Source.CurrentLanguageName);
end;


end.
